Transactor/Transactor_12_1986_Transactor_Publishing.d64/cmd wedge.pal

Commodore BASIC | 2023-02-26 | 8KB | 305 lines

1000 ;
1010 ;command wedge
1020 ;by frank e. digioia
1030 ;11/17/85
1040 ;
1050 * = $c200
1060 ;
1070 init   lda #<cwedge    ;install wedge
1080 sta $0308
1090 lda #>cwedge
1100 sta $0309
1110 rts
1120 ;
1130 cwedge = *             ;this is the wedge
1140 jsr chrget      ;get next byte
1150 jsr chktok      ;what is itprint
1160 jmp $a7ae       ;interpreter loop
1170 ;
1180 rem    jmp $a93b       ;basic rem command
1190 ;
1200 chktok cmp #$27        ;single quoteprint
1210 beq rem         ;new rem command
1220 tax             ;set flags
1230 bpl wexit       ;not a token
1240 ;
1250 ldx #$00        ;use .x as index
1260 sta token       ;save for compare
1270 tloop  lda toktab,x    ;byte from table
1280 beq wexit       ;end of table
1290 cmp token       ;a matchprint
1300 beq exec        ;yes/execute it
1310 inx             ;no/bump index
1320 bne tloop       ;keep looking
1330 ;
1340 exec   txa             ;put offset in .a
1350 asl a           ;mult by two
1360 tax             ;use as index
1370 lda newadr+1,x  ;put address
1380 pha             ;of new routine
1390 lda newadr,x    ;on stack.
1400 pha
1410 jmp chrget      ;next byte & rts
1420 ;
1430 wexit  jsr chr(NULL)t      ;get byte again
1440 jmp $a7ed       ;give it to basic
1450 ;
1460 token  .byte $00
1470 toktab .byte $8c,$89,$8d,$9b,$92,$93,$94,$95,$00
1480 newadr .word restor-1,goto-1,gosub-1,list-1,wait-1,load-1,save-1,verify-1
1490 ;
1500 ;restore x,y -- all parms optional
1510 ;
1520 adr    = $5f           ;address of line
1530 chrget = $0073         ;get next byte
1540 chr(NULL)t = $0079         ;get last byte
1550 chkcom = $aefd         ;check on comma
1560 getin  = $ffe4         ;same as basic get
1570 getbyt = $b79e         ;get byte into .x
1580 frmnum = $ad8a         ;get numeric parm
1590 facint = $b7f7         ;change fac to int
1600 finadr = $a613         ;find adr of line
1610 undef  = $a8e3         ;undef'ed statment
1620 quote  = $22           ;ascii for quote
1630 data   = $83           ;token for data
1640 ;
1650 restor = *             ;new restore cmd
1660 bne *+5         ;any parmsprint
1670 jmp $a81d       ;no/use rom routine
1680 jsr getprm      ;yes/get line & adr
1690 lda adr         ;address lo
1700 ldy adr+1       ;address hi
1710 sec
1720 sbc #$01        ;subtract 1
1730 bcs *+3         ;decr hi byteprint
1740 dey
1750 sta $41         ;data pointer lo
1760 sty $42         ;data pointer hi
1770 jsr chr(NULL)t      ;another parmprint
1780 beq rdone       ;no/we're done
1790 ;
1800 jsr chkcom      ;yes/check comma
1810 jsr getbyt      ;get byte into .x
1820 txa
1830 beq rdone       ;0'th elementprintprintprint
1840 dex
1850 beq rdone       ;1'st element/done
1860 ldy #$04        ;.y is text index
1870 lda ($41),y     ;get byte of text
1880 cmp #data       ;data statement?
1890 bne findat      ;no/find it
1900 ;
1910 loop   iny             ;comma search loop
1920 lda ($41),y     ;get byte from line
1930 beq notfnd      ;end of line
1940 cmp #':'        ;colonprint
1950 beq notfnd      ;end of data stmnt
1960 cmp #quote      ;quoteprint
1970 beq finqte      ;find closing quote
1980 cmp #','        ;commaprint
1990 bne loop        ;no/try again
2000 dex             ;found one!
2010 bne loop        ;need .x more
2020 ;
2030 tya             ;put offset in .a
2040 clc             ;update the data
2050 adc $41         ;pointers
2060 sta $41
2070 bcc *+4
2080 inc $42
2090 rdone  rts
2100 ;
2110 findat lda #data       ;token for data
2120 .byte $2c       ;skip next instr.
2130 ;
2140 finqte lda #quote      ;token for quote
2150 sta $fb         ;save byte to find
2160 ;
2170 bloop  = *             ;find byte at $fb
2180 iny
2190 lda ($41),y     ;get byte of text
2200 beq notfnd      ;end of line
2210 cmp $fb         ;found itprint
2220 beq loop        ;yes/goto main loop
2230 bne bloop       ;no/keep looking
2240 ;
2250 notfnd = *             ;print mesg & die
2260 lda #<msg
2270 ldy #>msg
2280 jmp $a469       ;output err mesg
2290 ;
2300 getprm = *             ;get parm & check it
2310 jsr frmnum      ;get parm in fac
2320 jsr facint      ;convert to int.
2330 jsr finadr      ;get adr of line
2340 bcs found       ;line foundprint
2350 jmp undef       ;no/undef'ed line
2360 found  rts
2370 ;
2380 msg    .byte 'data element not found'
2390 eom    .byte $00
2400 ;
2410 ;goto -- computed goto statement
2420 ;
2430 goto   jsr frmnum      ;get parm in fac
2440 jsr facint      ;convert to integer
2450 jmp $a8a3       ;that's all folks!
2460 ;
2470 ;gosub - computed gosub statement
2480 ;
2490 gosub  lda #$03        ;half # of bytes
2500 jsr $a3fb       ;enough stack spaceprint
2510 lda $7b         ;text pointer hi
2520 pha
2530 lda $7a         ;text pointer lo
2540 pha
2550 lda $3a         ;line number hi
2560 pha
2570 lda $39         ;line number lo
2580 pha
2590 lda #$8d        ;token for gosub
2600 pha             ;as i.d. on stack
2610 jsr goto        ;do a goto
2620 jmp $a7ae       ;interpreter loop
2630 ;
2640 ;list - a list subroutine
2650 ;
2660 ierror = $0300         ;error vector
2670 olderr = $e38b         ;old vector
2680 ;
2690 list   ldx $3a         ;direct modeprint
2700 inx             ;set flags
2710 bne *+5         ;no/use our routine
2720 jmp $a69c       ;yes/use old one
2730 lda #<return    ;point error
2740 sta ierror      ;vector at return
2750 lda #>return    ;address for list
2760 sta ierror+1
2770 jsr chr(NULL)t      ;get byte again
2780 jsr $a69c       ;real list cmd
2790 ;
2800 return lda #<olderr    ;set error
2810 sta ierror      ;vector back to
2820 lda #>olderr    ;normal.
2830 sta ierror+1
2840 rts
2850 ;
2860 ;wait -- pause until key pressed
2870 ;
2880 wait   beq *+5         ;any parmsprint
2890 jmp $b82d       ;yes/use old wait
2900 wloop  jsr getin       ;get character
2910 beq wloop       ;buffer emptyprint
2920 sta $02         ;save character
2930 rts
2940 ;
2950 ;load/save -- all parms optional
2960 ;
2970 setnam = $ffbd         ;set name parameter
2980 setlfs = $ffba         ;set file parameter
2990 ;
3000 verify lda #$01        ;verify flag
3010 .byte $2c       ;skip next instr.
3020 load   lda #$00        ;flag for load
3030 sta $0a         ;store system flag
3040 lda #$00        ;act like load now
3050 .byte $2c       ;skip next instr.
3060 save   lda #$01        ;flag for save
3070 sta lsflag      ;store our flag
3080 lda #$00        ;default length
3090 jsr setnam      ;set default name
3100 ldx #$08        ;default device#
3110 jsr $e1db       ;get any parms
3120 lda $b7         ;length of name
3130 beq noname      ;no name specified
3140 ;
3150 sta len         ;store new name
3160 tay             ;use .y as index
3170 lda #$00        ;end name with 0
3180 sta name,y
3190 ;
3200 nloop  dey             ;copy new filename
3210 lda ($bb),y     ;get byte of name
3220 sta name,y      ;save it
3230 bne nloop       ;keep it up
3240 beq exit        ;continue command
3250 ;
3260 noname = *             ;no name specified
3270 lda len         ;is name definedprint
3280 beq exit        ;no/error coming up
3290 lda lsflag      ;load or saveprint
3300 beq setup       ;load/finish up
3310 ;
3320 lda name        ;set up two char
3330 sta abr         ;abbreviation of
3340 lda name+1      ;filename for
3350 sta abr+1       ;easy backup
3360 ;
3370 jsr scrach      ;scratch old backup
3380 jsr rename      ;create backup copy
3390 ;
3400 setup  lda len         ;get parameters
3410 ldx #<name      ;for filename to
3420 ldy #>name      ;load or save
3430 jsr setnam      ;set parameters
3440 ;
3450 exit   lda lsflag      ;load or saveprint
3460 bne save2       ;save commandprint
3470 jmp $e16f       ;continue load cmd
3480 ;
3490 save2  ldx $2d         ;end adr of save
3500 ldy $2e         ;i.e. start of vars
3510 lda #$2b        ;point to start adr
3520 jsr $ffd8       ;continue save cmd
3530 bcc *+5         ;normal termination
3540 jmp $e0f9       ;no/"break" error
3550 rts
3560 ;
3570 scrach = *             ;scratch backup
3580 lda #'s'        ;'s' for scratch
3590 sta cmd         ;set command
3600 lda #$00        ;end of buffer
3610 sta equal       ;no equal sign
3620 jmp send        ;send dos command
3630 ;
3640 rename = *             ;rename old file
3650 lda #'r'        ;'r' for rename
3660 sta cmd         ;set command
3670 lda #'='        ;equal sign
3680 sta equal       ;where elseprint
3690 jmp send        ;send dos command
3700 ;
3710 ;
3720 ;send -- this routine can be used
3730 ;to send any dos command to drive
3740 ;be sure to end command with zero
3750 ;
3760 ciout  = $ffa8         ;send serial port
3770 listen = $ffb1         ;tell drive listen
3780 second = $ff93         ;send 2nd adr lstn
3790 unlstn = $ffae         ;quit listening
3800 ;
3810 send   lda #$08        ;device number
3820 sta $ba         ;store for system
3830 jsr listen      ;listen to command
3840 lda #$6f        ;ch # or'ed w/$60
3850 sta $b9         ;secondary adr
3860 jsr second      ;send it to drive
3870 ;
3880 ldx #$00        ;use .x as index
3890 dloop  lda cmd,x       ;get byte of cmd
3900 beq exit1       ;0 byte marks end
3910 jsr ciout       ;output to drive
3920 inx             ;bump pointer
3930 bne dloop       ;jmp to dloop
3940 ;
3950 exit1  jmp unlstn      ;all done!
3960 ;
3970 len    .byte $00
3980 cmd    .byte 's0:'
3990 abr    .byte $00,$00,'.bak'
4000 equal  .byte $00
4010 name   * = *+16
4020 lsflag .byte $00
4030 .end